W raporcie wykorzystano następujące biblioteki:
library(knitr)
library(dplyr)
library(tidyr)
library(ggplot2)
library(plotly)
library(ggcorrplot)
library(caret)
library(tibble)
Materials Project to inicjatywa naukowa Departamentu Energii USA, której celem jest dostarczanie otwartych danych i narzędzi do analizy materiałów. Jednym z kluczowych zbiorów danych dostępnych w ramach Materials Project jest baza danych dotycząca materiałów używanych w bateriach, która zawiera informacje o ich składzie chemicznym i parametrach wydajnościowych.
df <- read.csv("./data/mp_batteries.csv", na.strings="?")
df <- tbl_df(df)
| Nazwa atrybutu | Opis |
|---|---|
| Battery ID | Identyfikator baterii. |
| Battery Formula | Wzór chemiczny materiału baterii. |
| Working Ion | Główny jon, który odpowiada za transport ładunku w baterii. |
| Formula Charge | Wzór chemiczny materiału baterii w stanie naładowanym. |
| Formula Discharge | Wzór chemiczny materiału baterii w stanie rozładowanym. |
| Max Delta Volume | Zmiana objętości w % dla danego kroku napięcia za pomocą wzoru : max(charge, discharge)/min(charge, discharge) -1. |
| Average Voltage | Średnie napięcie dla poszczególnego kroku napięcia. |
| Gravimetric Capacity | Pojemność grawimetryczna, czyli ilość energii na jednostkę masy (mAh/g). |
| Volumetric Capacity | Pojemność wolumetryczna, czyli ilość energii na jednostkę objętości (mAh/cm³). |
| Gravimetric Energy | Gęstość energii w odniesieniu do masy baterii (Wh/kg). |
| Volumetric Energy | Gęstość energii w odniesieniu do objętości baterii (Wh/L). |
| Atomic Fraction Charge | Udział atomowy składników w stanie naładowanym. |
| Atomic Fraction Discharge | Udział atomowy składników w stanie rozładowanym. |
| Stability Charge | Wskaźnik stabilności materiału w stanie naładowanym. |
| Stability Discharge | Wskaźnik stabilności materiału w stanie rozładowanym. |
| Steps | Liczba odrębnych kroków napięcia od pełnego naładowania do rozładowana, oparta na stabilnych stanach pośrednich. |
| Max Voltage Step | Maksymalna bezwzględna różnica między sąsiednimi krokami napięcia. |
Poniżej znajduje się lista kroków wykonanych na zbiorze danych w celu przygotowania go do anaizy.
## tibble [4,351 × 17] (S3: tbl_df/tbl/data.frame)
## $ Battery.ID : chr [1:4351] "mp-30_Al" "mp-1022721_Al" "mp-8637_Al" "mp-129_Al" ...
## $ Battery.Formula : chr [1:4351] "Al0-2Cu" "Al1-3Cu" "Al0-5Mo" "Al0-12Mo" ...
## $ Working.Ion : chr [1:4351] "Al" "Al" "Al" "Al" ...
## $ Formula.Charge : chr [1:4351] "Cu" "AlCu" "Mo" "Mo" ...
## $ Formula.Discharge : chr [1:4351] "Al2Cu" "Al3Cu" "Al5Mo" "Al12Mo" ...
## $ Max.Delta.Volume : num [1:4351] 3.04 1.24 4.76 12.72 12.49 ...
## $ Average.Voltage : num [1:4351] 0.089 -0.0216 0.1228 0.0431 0.0292 ...
## $ Gravimetric.Capacity : num [1:4351] 1368 1113 1742 2299 1901 ...
## $ Volumetric.Capacity : num [1:4351] 5563 4419 7176 7346 7333 ...
## $ Gravimetric.Energy : num [1:4351] 121.8 -24 213.8 99.1 55.6 ...
## $ Volumetric.Energy : num [1:4351] 495.3 -95.4 880.9 316.8 214.4 ...
## $ Atomic.Fraction.Charge : num [1:4351] 0 0.5 0 0 0 ...
## $ Atomic.Fraction.Discharge: num [1:4351] 0.667 0.75 0.833 0.923 0.923 ...
## $ Stability.Charge : num [1:4351] 0 0.0741 0.4115 0 0 ...
## $ Stability.Discharge : num [1:4351] 0 0.0962 0.0452 0.0114 0 ...
## $ Steps : int [1:4351] 1 1 1 1 1 1 1 1 1 1 ...
## $ Max.Voltage.Step : num [1:4351] 0 0 0 0 0 0 0 0 0 0 ...
## # A tibble: 6 × 17
## Battery.ID Battery.Formula Working.Ion Formula.Charge Formula.Discharge
## <chr> <chr> <chr> <chr> <chr>
## 1 mp-30_Al Al0-2Cu Al Cu Al2Cu
## 2 mp-1022721_Al Al1-3Cu Al AlCu Al3Cu
## 3 mp-8637_Al Al0-5Mo Al Mo Al5Mo
## 4 mp-129_Al Al0-12Mo Al Mo Al12Mo
## 5 mp-91_Al Al0-12W Al W Al12W
## 6 mp-1055908_Al Al0-12Mn Al Mn MnAl12
## # ℹ 12 more variables: Max.Delta.Volume <dbl>, Average.Voltage <dbl>,
## # Gravimetric.Capacity <dbl>, Volumetric.Capacity <dbl>,
## # Gravimetric.Energy <dbl>, Volumetric.Energy <dbl>,
## # Atomic.Fraction.Charge <dbl>, Atomic.Fraction.Discharge <dbl>,
## # Stability.Charge <dbl>, Stability.Discharge <dbl>, Steps <int>,
## # Max.Voltage.Step <dbl>
Sprawdzenie ile jest pustych wartościami w poszczególnych kolumnach oraz ile w zbiorze jest zduplikowanych wierszy.
colSums(is.na(df))
## Battery.ID Battery.Formula Working.Ion
## 0 0 0
## Formula.Charge Formula.Discharge Max.Delta.Volume
## 0 0 0
## Average.Voltage Gravimetric.Capacity Volumetric.Capacity
## 0 0 0
## Gravimetric.Energy Volumetric.Energy Atomic.Fraction.Charge
## 0 0 0
## Atomic.Fraction.Discharge Stability.Charge Stability.Discharge
## 0 0 0
## Steps Max.Voltage.Step
## 0 0
duplicates_count <- sum(duplicated(df))
print(paste("Liczba zduplikowanych wierszy:", duplicates_count))
## [1] "Liczba zduplikowanych wierszy: 0"
Z powodu braku zduplikowanych danych oraz braku wartości pustych w zbiorze - dane nie wymagają czyszczenia.
Zbiór danych składa się z 4351 wierszy (obserwacji) i 17 kolumn (atrybutów).
kable(summary(df %>% select(Max.Delta.Volume:Volumetric.Energy)))
| Max.Delta.Volume | Average.Voltage | Gravimetric.Capacity | Volumetric.Capacity | Gravimetric.Energy | Volumetric.Energy | |
|---|---|---|---|---|---|---|
| Min. : 0.00002 | Min. :-7.755 | Min. : 5.176 | Min. : 24.08 | Min. :-583.5 | Min. :-2208.1 | |
| 1st Qu.: 0.01747 | 1st Qu.: 2.226 | 1st Qu.: 88.108 | 1st Qu.: 311.62 | 1st Qu.: 211.7 | 1st Qu.: 821.6 | |
| Median : 0.04203 | Median : 3.301 | Median : 130.691 | Median : 507.03 | Median : 401.8 | Median : 1463.8 | |
| Mean : 0.37531 | Mean : 3.083 | Mean : 158.291 | Mean : 610.62 | Mean : 444.1 | Mean : 1664.0 | |
| 3rd Qu.: 0.08595 | 3rd Qu.: 4.019 | 3rd Qu.: 187.600 | 3rd Qu.: 722.75 | 3rd Qu.: 614.4 | 3rd Qu.: 2252.3 | |
| Max. :293.19322 | Max. :54.569 | Max. :2557.627 | Max. :7619.19 | Max. :5926.9 | Max. :18305.9 |
kable(summary(df %>% select(Atomic.Fraction.Charge:Max.Voltage.Step)))
| Atomic.Fraction.Charge | Atomic.Fraction.Discharge | Stability.Charge | Stability.Discharge | Steps | Max.Voltage.Step | |
|---|---|---|---|---|---|---|
| Min. :0.00000 | Min. :0.007407 | Min. :0.00000 | Min. :0.00000 | Min. :1.000 | Min. : 0.0000 | |
| 1st Qu.:0.00000 | 1st Qu.:0.086957 | 1st Qu.:0.03301 | 1st Qu.:0.01952 | 1st Qu.:1.000 | 1st Qu.: 0.0000 | |
| Median :0.00000 | Median :0.142857 | Median :0.07319 | Median :0.04878 | Median :1.000 | Median : 0.0000 | |
| Mean :0.03986 | Mean :0.159077 | Mean :0.14257 | Mean :0.12207 | Mean :1.167 | Mean : 0.1503 | |
| 3rd Qu.:0.04762 | 3rd Qu.:0.200000 | 3rd Qu.:0.13160 | 3rd Qu.:0.09299 | 3rd Qu.:1.000 | 3rd Qu.: 0.0000 | |
| Max. :0.90909 | Max. :0.993333 | Max. :6.48710 | Max. :6.27781 | Max. :6.000 | Max. :26.9607 |
W tym zbiorze można odczytać następujące cechy statystyczne:
Poniżej znajduje się analiza zbioru danych w celu zbadania rozkładów wartości poszczególnych atrybutów oraz sprawdzenia występujących między nimi korelacji.
p <- ggplot(df, aes(x = `Working.Ion`)) +
geom_bar(fill = "blue", color = "black") +
labs(
title = "Histogram głównego jonu baterii",
x = "Główny Jon",
y = "Liczba"
) +
theme_light()
ggplotly(p)
p1 <- ggplot(df, aes(x = `Max.Delta.Volume`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
labs(
title = "Rozkład maksymalnej zmiany objętości dla danego kroku",
x = "Maksymalna zmiana objętości",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
p1 <- ggplot(df, aes(x = `Average.Voltage`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
labs(
title = "Rozkład średniego napięcia",
x = "Średnie napięcie",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
p1 <- ggplot(df, aes(x = `Gravimetric.Capacity`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
labs(
title = "Rozkład pojemności grawimetrycznej",
x = "Pojemność grawimetryczna",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
p1 <- ggplot(df, aes(x = `Volumetric.Capacity`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
labs(
title = "Rozkład pojemności wolumetrycznej",
x = "Pojemność wolumetryczna",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
p1 <- ggplot(df, aes(x = `Gravimetric.Energy`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
labs(
title = "Rozkład energii grawimetrycznej",
x = "Energia grawimetryczna",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
p1 <- ggplot(df, aes(x = `Volumetric.Energy`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
labs(
title = "Rozkład energii wolumetrycznej",
x = "Energia wolumetryczna",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
p1 <- ggplot(df, aes(x = `Atomic.Fraction.Charge`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
labs(
title = "Rozkład udziału atomowego składników w stanie naładowanym",
x = "Udział atomowy składników",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
p1 <- ggplot(df, aes(x = `Atomic.Fraction.Discharge`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
labs(
title = "Rozkład udziału atomowego składników w stanie rozładowanym",
x = "Udział atomowy składników",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
p1 <- ggplot(df, aes(x = `Stability.Charge`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
labs(
title = "Rozkład wskaźnika stabilności materiału w stanie naładowanym",
x = "Wskaźnik stabilności materiału",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
p1 <- ggplot(df, aes(x = `Stability.Discharge`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
labs(
title = "Rozkład wskaźnika stabilności materiału w stanie rozładowanym",
x = "Wskaźnik stabilności materiału",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
p1 <- ggplot(df, aes(x = `Steps`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
labs(
title = "Rozkład liczba odrębnych kroków napięcia od pełnego naładowania do rozładowana",
x = "Liczba kroków",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
p1 <- ggplot(df, aes(x = `Max.Voltage.Step`)) +
geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
labs(
title = "Rozkład maksymalnej bezwzględnej różnica między sąsiednimi krokami napięcia",
x = "Maksymalna bezwzględna różnica między sąsiednimi krokami napięcia",
y = "Liczba obserwacji"
) +
theme_light()
ggplotly(p1)
cor_matrix <- df %>%
select(`Max.Delta.Volume`:last_col()) %>%
cor(method="pearson")
correlation_long <- cor_matrix %>%
as.data.frame() %>%
mutate(variable1 = colnames(cor_matrix)) %>%
pivot_longer(-variable1,
names_to = "variable2",
values_to = "correlation"
) %>%
filter(variable1 > variable2)
correlation_plot <- ggplot(
correlation_long,
aes(x = variable1, y = variable2, fill = correlation)
) +
geom_tile() +
scale_fill_gradient2(
low = "blue", mid = "white", high = "red",
midpoint = 0, limits = c(-1, 1)
) +
geom_text(aes(label = sprintf("%.2f", correlation)), size = 3) +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
axis.title = element_blank()
) +
labs(fill = "Korelacja")
ggplotly(correlation_plot)
plot_correlation <- function(df, var1, var2) {
ggplot(df, aes_string(x = var1, y = var2)) +
geom_point(alpha = 0.5, color = "blue") +
geom_smooth(method = "lm", se = TRUE, color = "red", fill = "pink") +
theme_minimal() +
labs(
title = paste("Korelacja między", var1, "a", var2),
x = var1,
y = var2
) +
theme(
plot.title = element_text(hjust = 0.5, size = 14),
axis.text = element_text(size = 10),
axis.title = element_text(size = 11)
)
}
pairs <- list(
c("Gravimetric.Energy", "Volumetric.Energy"),
c("Gravimetric.Capacity", "Volumetric.Capacity"),
c("Stability.Charge", "Stability.Discharge")
)
for (pair in pairs) {
print(plot_correlation(df, pair[1], pair[2]))
}
Aby zredukować korelacje między atrybutami, zastosowano funkcję findCorrelation z pakietu caret, ustawiając próg (cutoff) na 0.8. Funkcja ta identyfikuje atrybuty, które są silnie skorelowane i mogą zostać usunięte z analizy.
attributes_to_remove <- cor_matrix %>% findCorrelation(cutoff = 0.8, names = TRUE)
Atrybuty, które zostały wybrane do usunięcia: Gravimetric.Energy, Gravimetric.Capacity, Stability.Charge.
Do budowy modelu predykcyjnego usunięto atrybuty Gravimetric.Energy, Gravimetric.Capacity, Stability.Charge oraz Battery.ID. Dane zostały podzielone na zbiór uczący (70%) oraz testowy (30%). Dodatkowo, w celu oceny modelu, zastosowano ocenę krzyżową (cross-validation) z 10-krotnym podziałem zbioru danych na podzbiory.
df$Battery.Formula <- as.numeric(factor(df$Battery.Formula))
df$Working.Ion <- as.numeric(factor(df$Working.Ion))
df$Formula.Charge <- as.numeric(factor(df$Formula.Charge))
df$Formula.Discharge <- as.numeric(factor(df$Formula.Discharge))
in_training_data <- createDataPartition(y = df$Average.Voltage, p = 0.70, list = FALSE)
training_data <- df[in_training_data, ] %>% select(-c(Battery.ID, attributes_to_remove))
testing_data <- df[-in_training_data, ]
ctrl <- trainControl(method = "cv", number = 10)
Poniższy wykres przedstawia podobieństwo rozkładów danych treningowych i testowych.
ggplot() +
geom_density(aes(x = Average.Voltage, fill = "Treningowy"), data = training_data, alpha = 0.6) +
geom_density(aes(x = Average.Voltage, fill = "Testowy"), data = testing_data, alpha = 0.6) +
labs(x = "Average Voltage", y = "Gęstość", fill = "Zbiór danych") +
theme_light()
model_lm <- train(
Average.Voltage ~ .,
data = training_data,
method = "lm",
trControl = ctrl
)
summary(model_lm)
##
## Call:
## lm(formula = .outcome ~ ., data = dat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.3628 -0.6205 -0.0532 0.5495 23.7899
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.137e+00 1.156e-01 27.134 < 2e-16 ***
## Battery.Formula -2.763e-04 5.412e-05 -5.105 3.52e-07 ***
## Working.Ion -2.464e-02 2.720e-02 -0.906 0.365138
## Formula.Charge -1.272e-04 3.465e-05 -3.672 0.000245 ***
## Formula.Discharge 1.570e-04 4.303e-05 3.648 0.000268 ***
## Max.Delta.Volume 2.318e-01 2.532e-02 9.155 < 2e-16 ***
## Volumetric.Capacity -1.379e-03 6.060e-05 -22.765 < 2e-16 ***
## Volumetric.Energy 9.911e-04 2.085e-05 47.534 < 2e-16 ***
## Atomic.Fraction.Charge 2.533e+00 4.379e-01 5.785 7.97e-09 ***
## Atomic.Fraction.Discharge -1.222e+00 4.222e-01 -2.894 0.003827 **
## Stability.Discharge -4.252e-01 6.202e-02 -6.856 8.56e-12 ***
## Steps -2.614e-01 6.466e-02 -4.044 5.40e-05 ***
## Max.Voltage.Step 1.054e-01 5.892e-02 1.789 0.073685 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.174 on 3034 degrees of freedom
## Multiple R-squared: 0.5248, Adjusted R-squared: 0.5229
## F-statistic: 279.2 on 12 and 3034 DF, p-value: < 2.2e-16
predictions <- predict(model_lm, newdata = testing_data)
post_resample <- postResample(pred = predictions,
obs = testing_data$Average.Voltage)
post_resample
## RMSE Rsquared MAE
## 3.01947804 0.07085073 0.92448763
rmse <- sqrt(mean((testing_data$Average.Voltage - predictions)^2))
cat("RMSE na zbiorze testowym:", rmse)
## RMSE na zbiorze testowym: 3.019478
Poniższy wykres przedstawia wartości zbioru testowego oraz wartości przewidziane przez regresor.
prediction_comparison_df <- tibble(X = testing_data$Battery.ID,
actual = testing_data$Average.Voltage,
predicted = predictions)
prediction_comparison_df$Observation <- seq_along(prediction_comparison_df$X)
p <- ggplot(prediction_comparison_df, aes(x = Observation)) +
geom_smooth(aes(y = actual, color = "Wartość rzeczywista"), method = "lm", se = FALSE, linetype = "solid") +
geom_smooth(aes(y = predicted, color = "Wartość przewidziana"), method = "lm", se = FALSE, linetype = "dashed") +
geom_line(aes(y = actual, color = "Wartość rzeczywista"), linetype = "solid", alpha = 0.2) +
geom_line(aes(y = predicted, color = "Wartość przewidziana"), linetype = "dashed", alpha = 0.2) +
labs(color = "Wartości", x = "Nr obserwacji", y = "Average Voltage [V]") +
theme_light() +
scale_x_continuous(
breaks = seq(1, nrow(prediction_comparison_df), by = 1000),
labels = scales::comma_format()
) + scale_y_continuous(
limits = c(min(prediction_comparison_df$actual, prediction_comparison_df$predicted),
max(prediction_comparison_df$actual, prediction_comparison_df$predicted))
) + theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(p)
importance <- varImp(model_lm, scale = FALSE)
importance_df <- importance$importance %>%
rownames_to_column(var = "attribute") %>%
arrange(desc(Overall))
p <- ggplot(importance_df, aes(x = reorder(attribute, Overall), y = Overall, fill = Overall)) +
geom_bar(stat = "identity") +
labs(x = "Atrybut", y = "Ważność") +
scale_fill_gradient() +
theme_light() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(p)